{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit Embedding;

interface

(*
TODO:

- add proper support for mouse double click event (confuses mouse state currently)
- add support for handling scrollbars
- add support for handling non-client area mouse events (menus etc.)
- add properties to plugin window for specifying cropping, scaling etc.

*)

uses Classes, Windows, Masks, RenderCache;

type
  TPrintWindow = function(SourceWindow: HWND; Destination: HDC; Flags: UINT): Bool; stdcall;

  TAHMEmbeddingManager = class;

  TAHMWindowProcWrapper = class
  private
    FMatchCaption: Boolean;
    FMatchClass: Boolean;
    FWindowCaption: String;
    FWindowClass: String;
    FWindowHandle: HWND;
    FCaptionMask: TMask;
    FClassMask: TMask;
  protected
    procedure SetWindowCaption(WindowCaption: String);
    procedure SetWindowClass(WindowClass: String);
  public
    destructor Destroy; override;
    property MatchCaption: Boolean read FMatchCaption;
    property MatchClass: Boolean read FMatchClass;
    property WindowCaption: String read FWindowCaption write SetWindowCaption;
    property WindowClass: String read FWindowClass write SetWindowClass;
    property WindowHandle: HWND read FWindowHandle write FWindowHandle;
    function CheckClass(WindowClass: String): Boolean;
    function CheckCaption(WindowCaption: String): Boolean;
  end;

  TAHMEmbeddedInstance = class
  private
    FWindowName: String;
    FWindowClass: String;
    FWinHandle: HWND;
    FDlgHandle: HWND;
    FChildHandle: HWND;
    FChildX: Integer;
    FChildY: Integer;
    FClientX: Integer;
    FClientY: Integer;
    FMouseX: Integer;
    FMouseY: Integer;
    FWindowX: Integer;
    FWindowY: Integer;
    FWindowW: Integer;
    FWindowH: Integer;
    FAppPath: String;
    FLockUpdates: Boolean;
    FOwner: TAHMEmbeddingManager;
    FWrapper: TAHMWindowProcWrapper;
    function GetChildWindow(const Parent: HWND; const ScreenPt: TPoint): HWND;
  protected
    procedure SelectControl(MousePt: TPoint);
    function GetWindowHandle: HWND;
    function GetDisplayHandle: HWND;
    function CorrectCoords(const X, Y: Single): TPoint;
    function EncodeCoords: LPARAM;
  public
    constructor Create(Owner: TAHMEmbeddingManager);
    destructor Destroy; override;
    property WindowName: String read FWindowName write FWindowName;
    property WindowClass: String read FWindowClass write FWindowClass;
    property WindowHandle: HWND read FWinHandle write FWinHandle;
    property DisplayHandle: HWND read GetDisplayHandle;
    property ApplicationPath: String read FAppPath write FAppPath;
    property LockUpdates: Boolean read FLockUpdates write FLockUpdates;
    procedure MouseDown(X, Y: Single);
    procedure MouseUp(X, Y: Single);
    procedure MouseMove(X, Y: Single; Down: Boolean);
    procedure KeyPress(KeyCode: Word; Shift: TShiftState);
    procedure UpdateDisplayCache(Cache: TAHMRenderCache);
    procedure InvalidateInstance;
  end;

  TAHMEmbeddedList = class
  private
    FItems: TList;
    FOwner: TAHMEmbeddingManager;
  protected
    function GetCount: Integer;
    function GetItem(Index: Integer): TAHMEmbeddedInstance;
  public
    constructor Create(Owner: TAHMEmbeddingManager);
    destructor Destroy; override;
    property Count: Integer read GetCount;
    property Items[Index: Integer]: TAHMEmbeddedInstance read GetItem; default;
    function AddItem: TAHMEmbeddedInstance;
    procedure DeleteItem(Item: TAHMEmbeddedInstance);
    procedure Clear;
  end;

  TAHMEmbeddingManager = class
  private
    FUser32Handle: Integer;
    PrintWindow: TPrintWindow;
    FEmbedded: TAHMEmbeddedList;
  protected
    function BlitWindow(Source: HWND; Destination: HDC; Lock: Boolean): Boolean;
  public
    constructor Create;
    destructor Destroy; override;
    function AttachApplication(const WindowName, WindowClass: String; LockUpdates: Boolean): TAHMEmbeddedInstance;
  end;

implementation

uses SysUtils, Messages, Screen, Utilities, Logging;

// EnumWindows callback function for matching window class/caption
function MatchWindow(Window: HWND; Wrapper: TAHMWindowProcWrapper): Boolean; stdcall;
var
  Buffer: array[0..255] of Char;
begin
  // Set default result - keep searching
  Result := True;

  // Match window class first
  if Wrapper.MatchClass then
  begin
    GetClassName(Window, Buffer, Length(Buffer));
    if not Wrapper.CheckClass(Buffer) then Exit;
  end;

  // Match window caption
  if Wrapper.MatchCaption then
  begin
    GetWindowText(Window, Buffer, Length(Buffer));
    if not Wrapper.CheckCaption(Buffer) then Exit;
  end;

  // Must be a match - stop searching
  Wrapper.WindowHandle := Window;
  Result := False;
end;

// TAHMWindowProcWrapper

destructor TAHMWindowProcWrapper.Destroy;
begin
  FCaptionMask.Free;
  FClassMask.Free;

  inherited;
end;

procedure TAHMWindowProcWrapper.SetWindowCaption(WindowCaption: String);
begin
  // Only need to update when search params change
  if FWindowCaption <> WindowCaption then
  begin
    FWindowCaption := WindowCaption;
    FMatchCaption := FWindowCaption <> '';

    // Create mask for partial matching if required
    FreeAndNil(FCaptionMask);
    if (Pos('?', FWindowCaption) > 0) or (Pos('*', FWindowCaption) > 0) then
      try
        FCaptionMask := TMask.Create(FWindowCaption);
      except
        LogError('Invalid plugin window caption format specified - ' + FWindowCaption);
      end;
  end;
end;

procedure TAHMWindowProcWrapper.SetWindowClass(WindowClass: String);
begin
  // Only need to update when search params change
  if FWindowClass <> WindowClass then
  begin
    FWindowClass := WindowClass;
    FMatchClass := FWindowClass <> '';

    // Create mask for partial matching if required
    FreeAndNil(FClassMask);
    if (Pos('?', FWindowClass) > 0) or (Pos('*', FWindowClass) > 0) then
      try
        FClassMask := TMask.Create(FWindowClass);
      except
        LogError('Invalid plugin window class format specified - ' + FWindowClass);
      end;
  end;
end;

function TAHMWindowProcWrapper.CheckClass(WindowClass: String): Boolean;
begin
  // Perform partial/exact match of class
  if FClassMask <> nil then
    Result := FClassMask.Matches(WindowClass)
  else
    Result := FWindowClass = WindowClass;
end;

function TAHMWindowProcWrapper.CheckCaption(WindowCaption: String): Boolean;
begin
  // Perform partial/exact match of caption
  if FCaptionMask <> nil then
    Result := FCaptionMask.Matches(WindowCaption)
  else
    Result := FWindowCaption = WindowCaption;
end;

// TAHMEmbeddedInstance

constructor TAHMEmbeddedInstance.Create(Owner: TAHMEmbeddingManager);
begin
  inherited Create;

  FOwner := Owner;
  FWrapper := TAHMWindowProcWrapper.Create;
end;

destructor TAHMEmbeddedInstance.Destroy;
begin
  FWrapper.Free;

  inherited;
end;

function TAHMEmbeddedInstance.GetChildWindow(const Parent: HWND; const ScreenPt: TPoint): HWND;
var
  ClientPt: TPoint;
  Client: HWND;
begin
  // Convert screen coordinates to client space
  ClientPt := ScreenPt;
  ScreenToClient(Parent, ClientPt);

  // Is there a deeper child control here?
  Client := ChildWindowFromPointEx(Parent, ClientPt, CWP_SKIPINVISIBLE or CWP_SKIPDISABLED);

  if Client = 0 then Result := Parent
  else if Client <> Parent then Result := GetChildWindow(Client, ScreenPt)
  else Result := Client;
end;

procedure TAHMEmbeddedInstance.SelectControl(MousePt: TPoint);
var
  ChildRect: TRect;
begin
  // Determine handle of control beneath mouse cursor
  FChildHandle := GetChildWindow(FDlgHandle, MousePt);

  // Get origin of control relative to its dialog
  GetWindowRect(FChildHandle, ChildRect);
  FChildX := ChildRect.Left - FWindowX - FClientX;
  FChildY := ChildRect.Top - FWindowY - FClientY;
end;

function TAHMEmbeddedInstance.GetWindowHandle: HWND;
begin
  // Determine whether we need to find application handle
//TODO - don't continually search for a dead handle
  if FWinHandle = 0 then
  begin
    // Update window caption & class parameters for searching
    FWrapper.WindowCaption := FWindowName;
    FWrapper.WindowClass := FWindowClass;

    // Enumerate windows using our wrapper
    EnumWindows(@MatchWindow, LPARAM(FWrapper));
    FWinHandle := FWrapper.WindowHandle;
  end;

  Result := FWinHandle;
end;

function TAHMEmbeddedInstance.GetDisplayHandle: HWND;
var
  WinRect: TRect;
  CliOrigin: TPoint;
begin
  // Determine whether window is showing another dialog
  FDlgHandle := GetLastActivePopup(GetWindowHandle);

  // Record dimensions and position of new window
  GetWindowRect(FDlgHandle, WinRect);
  FWindowX := WinRect.Left;
  FWindowY := WinRect.Top;
  FWindowW := WinRect.Right - WinRect.Left;
  FWindowH := WinRect.Bottom - WinRect.Top;

  // Record client offset of new window
  CliOrigin := Point(0, 0);
  ClientToScreen(FDlgHandle, CliOrigin);
  FClientX := CliOrigin.X - FWindowX;
  FClientY := CliOrigin.Y - FWindowY;

  Result := FDlgHandle;
end;

function TAHMEmbeddedInstance.CorrectCoords(const X, Y: Single): TPoint;
begin
  // Scale coordinates to full extent of dialog window
  FMouseX := Round(X * FWindowW);
  FMouseY := Round(Y * FWindowH);

  // Apply offset to result for window position on screen
  Result := Point(FMouseX + FWindowX, FMouseY + FWindowY);

  // Apply coordinate offset for client region within window
  FMouseX := FMouseX - FClientX;
  FMouseY := FMouseY - FClientY;
end;

function TAHMEmbeddedInstance.EncodeCoords: LPARAM;
begin
  // If we're working with a child window then offset coords
  if FChildHandle <> FDlgHandle then
    Result := MakeLParam(FMouseX - FChildX, FMouseY - FChildY)
  else
    Result := MakeLParam(FMouseX, FMouseY);
end;

procedure TAHMEmbeddedInstance.MouseDown(X, Y: Single);
var
  Pt: TPoint;
begin
  Pt := CorrectCoords(X, Y);

  // Restore external window if it's currently minimised
  if IsIconic(FDlgHandle) then
  begin
    ShowWindow(FDlgHandle, SW_RESTORE);
    ScreenInstance.BringToFront;
  end;

  // Determine handle & origin of control beneath mouse cursor
  SelectControl(Pt);

  PostMessage(FChildHandle, WM_LBUTTONDOWN, MK_LBUTTON, EncodeCoords);
end;

procedure TAHMEmbeddedInstance.MouseUp(X, Y: Single);
begin
  CorrectCoords(X, Y);

  PostMessage(FChildHandle, WM_LBUTTONUP, 0, EncodeCoords);
end;

procedure TAHMEmbeddedInstance.MouseMove(X, Y: Single; Down: Boolean);
var
  Flags: DWORD;
begin
  CorrectCoords(X, Y);

  // Build message flags - is mouse button held down for dragging?
  if Down then Flags := MK_LBUTTON else Flags := 0;

  PostMessage(FChildHandle, WM_MOUSEMOVE, Flags, EncodeCoords);
end;

procedure TAHMEmbeddedInstance.KeyPress(KeyCode: Word; Shift: TShiftState);
begin
  // Send keydown events for modifier keys
  if ssShift in Shift then PostMessage(FChildHandle, WM_KEYDOWN, VK_SHIFT, 0);
  if ssAlt in Shift then PostMessage(FChildHandle, WM_KEYDOWN, VK_MENU, 0);
  if ssCtrl in Shift then PostMessage(FChildHandle, WM_KEYDOWN, VK_CONTROL, 0);

  // Send keydown for keycode unless it's just a modifier
  if (KeyCode <> VK_SHIFT) and (KeyCode <> VK_MENU) and (KeyCode <> VK_CONTROL) then
    PostMessage(FChildHandle, WM_KEYDOWN, KeyCode, 0);

  // Send keyup events for modifier keys
  if ssShift in Shift then PostMessage(FChildHandle, WM_KEYUP, VK_SHIFT, 0);
  if ssAlt in Shift then PostMessage(FChildHandle, WM_KEYUP, VK_MENU, 0);
  if ssCtrl in Shift then PostMessage(FChildHandle, WM_KEYUP, VK_CONTROL, 0);
end;

procedure TAHMEmbeddedInstance.UpdateDisplayCache(Cache: TAHMRenderCache);
var
  RenderHdl: HWND;
begin
  // If invalid render cache passed then just quit
  if not Assigned(Cache) then Exit;

  // Get window handle for our external application
  RenderHdl := GetDisplayHandle;

  // If handle no longer valid then clear the cache, otherwise snapshot a
  // copy of application window into the cache texture for rendering
  if RenderHdl = 0 then
    Cache.ClearCache
  else if Cache.LockGDICache(FWindowW, FWindowH) then
  begin
    FOwner.BlitWindow(RenderHdl, Cache.SurfaceHandle, FLockUpdates);
    Cache.UnlockGDICache;
  end;
end;

procedure TAHMEmbeddedInstance.InvalidateInstance;
begin
  // Reset window handles - app is no longer valid
  FWinHandle := 0;
  FDlgHandle := 0;
  FChildHandle := 0;
end;

// TAHMEmbeddedList

constructor TAHMEmbeddedList.Create(Owner: TAHMEmbeddingManager);
begin
  inherited Create;

  FOwner := Owner;
  FItems := TList.Create;
end;

destructor TAHMEmbeddedList.Destroy;
begin
  Clear;
  FItems.Free;

  inherited;
end;

function TAHMEmbeddedList.GetCount: Integer;
begin
  Result := FItems.Count;
end;

function TAHMEmbeddedList.GetItem(Index: Integer): TAHMEmbeddedInstance;
begin
  if (Index >= 0) and (Index < FItems.Count) then
    Result := TAHMEmbeddedInstance(FItems[Index])
  else
    Result := nil;
end;

procedure TAHMEmbeddedList.Clear;
var
  i: Integer;
begin
  for i := 0 to Pred(FItems.Count) do
    TAHMEmbeddedInstance(FItems[i]).Free;

  FItems.Clear;
end;

function TAHMEmbeddedList.AddItem: TAHMEmbeddedInstance;
begin
  Result := TAHMEmbeddedInstance.Create(FOwner);
  FItems.Add(Result);
end;

procedure TAHMEmbeddedList.DeleteItem(Item: TAHMEmbeddedInstance);
var
  i: Integer;
begin
  i := FItems.IndexOf(Item);
  if i >= 0 then
  begin
    TAHMEmbeddedInstance(FItems[i]).Free;
    FItems.Delete(i);
  end;
end;

// TAHMEmbeddingManager

constructor TAHMEmbeddingManager.Create;
begin
  inherited;

  FEmbedded := TAHMEmbeddedList.Create(Self);

  // Load Windows User32 DLL & query for PrintWindow method (XP only)
  FUser32Handle := LoadLibrary(PAnsiChar('user32.dll'));
  if FUser32Handle <> 0 then
  begin
    @PrintWindow := GetProcAddress(FUser32Handle, 'PrintWindow');
  end;
end;

destructor TAHMEmbeddingManager.Destroy;
begin
  // Disconnect methods and unload Windows User32 DLL
  @PrintWindow := nil;
  if FUser32Handle <> 0 then FreeLibrary(FUser32Handle);
  FUser32Handle := 0;

  FEmbedded.Free;

  inherited;
end;

function TAHMEmbeddingManager.AttachApplication(const WindowName, WindowClass: String; LockUpdates: Boolean): TAHMEmbeddedInstance;

var
  i: Integer;
begin
  // First loop through existing applications to see if we can re-use instance
  for i := 0 to Pred(FEmbedded.Count) do
    if (FEmbedded[i].WindowName = WindowName) and (FEmbedded[i].WindowClass = WindowClass) then
    begin
      // This instance may be stale, so refresh window handles
      Result := FEmbedded[i];
      Result.InvalidateInstance;
      Exit;
    end;

  // Not in our list yet, so create a new instance
  Result := FEmbedded.AddItem;
  Result.WindowName := WindowName;
  Result.WindowClass := WindowClass;
  Result.LockUpdates := LockUpdates;
end;

function TAHMEmbeddingManager.BlitWindow(Source: HWND; Destination: HDC; Lock: Boolean): Boolean;
const
  PW_CLIENTONLY = $00000001;
var
  Locked: Boolean;
begin
  // Set default result - unsupported
  Result := False;


  if @PrintWindow <> nil then
  begin
    Locked := Lock and LockWindowUpdate(Source);
    Result := PrintWindow(Source, Destination, 0);
//    Result := PrintWindow(Source, Destination, PW_CLIENTONLY);
    if Locked then LockWindowUpdate(0);
  end;
end;


end.
